home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / pstui100.zip / PTUIVCRT.PAS < prev    next >
Pascal/Delphi Source File  |  1993-03-12  |  27KB  |  1,091 lines
  1. {
  2.  
  3.                                                       ╔══════════════════╗
  4.                                                       ║  PTUI Virual     ║
  5.                                                       ║  Screen Driver   ║
  6.                                                       ║    Rev. 1.00     ║
  7.                                                       ╚══════════════════╝
  8.  
  9. }
  10.  
  11. {$F-} {$O-} {$A+} {$G-}
  12. {$V-} {$B-} {$X-} {$N+} {$E+}
  13.  
  14. {$I FINAL.PAS}
  15.  
  16. {$IFDEF FINAL}
  17.   {$I-} {$R-}
  18.   {$D-} {$L-} {$S-}
  19. {$ENDIF}
  20.  
  21. Unit PTUIVCRT;
  22.  
  23. Interface
  24.  
  25. Uses CRT,Strings;
  26.  
  27. Const
  28.   LMem_CRTPortBase = $463;
  29.   LMem_BufferLength= $44c;
  30.   LMem_NumberOfRows= $484;
  31.   LMem_NumberOfCols= $44a;
  32.   LMem_CurrentMode = $449;
  33.   LMem_BIOSFlags   = $489;
  34.  
  35.   MonoCard         =    1;
  36.   ColorCard        =    2;
  37.   Blink            =  128;
  38.   Black            =    0;
  39.   Blue             =    1;
  40.   Green            =    2;
  41.   Cyan             =    3;
  42.   Red              =    4;
  43.   Magenta          =    5;
  44.   Brown            =    6;
  45.   LightGray        =    7;
  46.   LightGrey        =    7;
  47.   DarkGray         =    8;
  48.   DarkGrey         =    8;
  49.   LightBlue        =    9;
  50.   LightGreen       =   10;
  51.   LightCyan        =   11;
  52.   LightRed         =   12;
  53.   LightMagenta     =   13;
  54.   Yellow           =   14;
  55.   White            =   15;
  56.  
  57. Type
  58.   MonoOrColor      = MonoCard..ColorCard;
  59.  
  60.   VideoScrollTypes = (ScrollAutoDetect, ScrollMethod1, ScrollMethod2,
  61.                       ScrollMethod3);
  62.  
  63.   VideoCardTypes   = (MDA,CGA,EGA,VGA,SVGA,BWVGA,HerculesInColor);
  64.  
  65.   VideoStateType   = Record
  66.                        FunctionalityInfo :Pointer;
  67.                        VideoMode         :Byte;
  68.                        Columns           :Word;
  69.                        RegenBufferLength :Word;
  70.                        RegenBufferAddr   :Word;
  71.                        CursorPos         :Array[1..8,1..2] of Byte;
  72.                        CursorType        :Word;
  73.                        ActivePage        :Byte;
  74.                        CRTControllerAddr :Word;
  75.                        Register3x8       :Byte;
  76.                        Register3x9       :Byte;
  77.                        Rows              :Byte;
  78.                        CharacterHeight   :Word;
  79.                        DisplayCode       :Byte;
  80.                        DisplayCodeAlt    :Byte;
  81.                        ColoursSupport    :Word;
  82.                        TotalDisplayPages :Byte;
  83.                        TotalScanLines    :Byte;
  84.                        PrimaryCharBlock  :Byte;
  85.                        SecondaryCharBlock:Byte;
  86.                        StateInformation  :Byte;
  87.                        Reserved1         :Array[1..3] of Byte;
  88.                        VideoMemory       :Byte;
  89.                        SavePointerState  :Byte;
  90.                        Reserved2         :Array[1..14] Of Byte;
  91.                      End;
  92.  
  93.   OneVideoCard     = Record
  94.                        XSize           :Word;
  95.                        YSize           :Word;
  96.                        SX1,SY1,                   {Screen}
  97.                        SX2,SY2         :Word;
  98.                        WX1,WY1,
  99.                        WX2,WY2         :Word;     {Window View Port}
  100.                        Address         :Word;     {Screen Segment to Display}
  101.                        CardType        :VideoCardTypes;
  102.                        CharacterHeight :Byte;
  103.                        CharacterLength :Byte;
  104.                        ScrollMethod    :VideoScrollTypes;
  105.                      End;
  106.  
  107. Var
  108.   VideoCard             :Array [MonoCard..ColorCard] of OneVideoCard;
  109.   Card                  :MonoOrColor;
  110.   TextAttr              :Byte;               {Background, Forground}
  111.   LastMode              :Byte;
  112.   Cursor                :Boolean;
  113.   VX                    :Word;
  114.   VY                    :Word;
  115.  
  116. Function  VideoWriteAddress(X1,Y1:Word):Pointer;
  117. Procedure InitVideoCards;
  118. Procedure SetVirtualScreen (XSize,YSize:Word);
  119. Procedure ScreenOrigin     (X,Y:Word);
  120.  
  121. Procedure PositionCursor;
  122. Procedure GotoXY           (X,Y:Word);
  123. Function  WhereX           :Word;
  124. Function  WhereY           :Word;
  125. Procedure ClrScr;
  126. Procedure ClrEOL;
  127. Procedure DelLine;
  128. Procedure InsLine;
  129. Procedure TextMode         (AL:Byte;BX,CX,DX:Word);
  130. Procedure TextColor        (Forg:Byte);
  131. Procedure TextBackground   (Backg:Byte);
  132. Procedure VideoColor       (Forg,Backg:Byte);
  133. Procedure HighVideo;
  134. Procedure LowVideo;
  135. Function  BackgroundColor  :Byte;
  136. Function  ForgroundColor   :Byte;
  137. Procedure Window           (X1,Y1,X2,Y2:Word);
  138. Procedure WriteChr         (Charac:Char);
  139. Procedure WriteStr         (Line:String);
  140. Procedure WriteStrLn       (Line:String);
  141. Procedure ReadStr          (X,Y:Word;MaxLets:Byte;Upper:Boolean;
  142.                             Var MainStr:String);
  143. Procedure EditStr          (X,Y:Word;MaxLets:Byte;Upper:Boolean;
  144.                             Var MainStr:String);
  145. Procedure Pad              (Count:Word;WithChar:Char);
  146. Procedure Barometer        (X,Y:Word;MaxLen:Byte;WithMe:Char;
  147.                             Current,EndPoint:LongInt);
  148. Procedure FillBlock        (X1,Y1,X2,Y2:Word;WithChar:Char);
  149. Function  TextImageSize    (X1,Y1,X2,Y2:Word):LongInt;
  150. Procedure GetTextImage     (X1,Y1,X2,Y2:Word;Data:Pointer);
  151. Procedure PutTextImage     (X1,Y1:Word;Data:Pointer);
  152. Procedure WindowToVScreen  (Var X1,Y1:Integer);
  153. Procedure WindowToVScreen4 (Var X1,Y1,X2,Y2:Integer);
  154. Procedure ScreenToVScreen  (Var X1,Y1:Integer);
  155. Procedure ScreenToVScreen4 (Var X1,Y1,X2,Y2:Integer);
  156.  
  157. Implementation
  158.  
  159. Function VideoWriteAddress(X1,Y1:Word):Pointer;
  160. Begin
  161.   Inc(X1,VideoCard[Card].WX1 - 1);
  162.   Inc(Y1,VideoCard[Card].WY1 - 1);
  163.   VideoWriteAddress:=Ptr(VideoCard[Card].Address,
  164.                          (((Y1-1)*VideoCard[Card].XSize*2)+((X1-1)*2)));
  165. End;
  166.  
  167. Procedure InitVideoCards;
  168. Begin
  169.   VideoCard[MonoCard].XSize    :=80;
  170.   VideoCard[MonoCard].YSize    :=25;
  171.   VideoCard[MonoCard].SX1      :=1;
  172.   VideoCard[MonoCard].SY1      :=1;
  173.   VideoCard[MonoCard].SX2      :=80;
  174.   VideoCard[MonoCard].SY2      :=25;
  175.   VideoCard[MonoCard].WX1      :=1;
  176.   VideoCard[MonoCard].WY1      :=1;
  177.   VideoCard[MonoCard].WX2      :=80;
  178.   VideoCard[MonoCard].WY2      :=25;
  179.   VideoCard[MonoCard].Address  :=$B000;
  180.   VideoCard[MonoCard].CardType :=MDA;
  181.   VideoCard[MonoCard].CharacterHeight:=16;
  182.   VideoCard[MonoCard].CharacterLength:=8;
  183.   VideoCard[MonoCard].ScrollMethod   :=ScrollAutoDetect;
  184.  
  185.   VideoCard[ColorCard].XSize    :=80;
  186.   VideoCard[ColorCard].YSize    :=25;
  187.   VideoCard[ColorCard].SX1      :=1;
  188.   VideoCard[ColorCard].SY1      :=1;
  189.   VideoCard[ColorCard].SX2      :=80;
  190.   VideoCard[ColorCard].SY2      :=25;
  191.   VideoCard[ColorCard].WX1      :=1;
  192.   VideoCard[ColorCard].WY1      :=1;
  193.   VideoCard[ColorCard].WX2      :=80;
  194.   VideoCard[ColorCard].WY2      :=25;
  195.   VideoCard[ColorCard].Address  :=$B800;
  196.   VideoCard[ColorCard].CardType :=CGA;
  197.   VideoCard[ColorCard].CharacterHeight:=16;
  198.   VideoCard[ColorCard].CharacterLength:=9;
  199.   VideoCard[ColorCard].ScrollMethod   :=ScrollAutoDetect;
  200.  
  201.   If MemW[$0:$0463] = $3B4 then
  202.     Card := MonoCard
  203.   Else
  204.     Card := ColorCard;
  205. End;
  206.  
  207. Procedure SetVirtualScreen(XSize,YSize:Word);
  208. Begin
  209.   VideoCard[ColorCard].XSize    :=XSize;
  210.   VideoCard[ColorCard].YSize    :=YSize;
  211.   VideoCard[ColorCard].SX1      :=1;
  212.   VideoCard[ColorCard].SY1      :=1;
  213.   VideoCard[ColorCard].WX1      :=1;
  214.   VideoCard[ColorCard].WY1      :=1;
  215.   VideoCard[ColorCard].WX2      :=XSize;
  216.   VideoCard[ColorCard].WY2      :=YSize;
  217.  
  218.   Asm
  219.     xor   ax, ax
  220.     mov   es, ax
  221.     mov   ax, XSize
  222.     mov   es:[LMem_NumberOfCols], ax
  223.     mov   cx, ax
  224.     mov   bx, YSize
  225.     dec   bx
  226.     mov   es:[LMem_NumberOfRows], bl
  227.     inc   bx
  228.     mul   bl
  229.     shl   ax, 1
  230.     mov   es:[LMem_BufferLength], ax
  231.  
  232.     shr   cx, 1
  233.     mov   ah, cl
  234.     mov   al, 13h
  235.     mov   dx, es:[LMem_CRTPortBase]
  236.     out   dx, ax
  237.   End;
  238. End;
  239.  
  240. Procedure ScreenOrigin(X,Y:Word);
  241.  
  242. Var
  243.   SX,
  244.   SY,
  245.   BytesPerRow     :Word;
  246.   CharacterHeight :Byte;
  247.   CharacterLength :Byte;
  248.   ScrollMethod    :VideoScrollTypes;
  249.  
  250. Label
  251.   UseAu